home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / ADDROM~1.FRM < prev    next >
Text File  |  1997-06-14  |  6KB  |  182 lines
  1. VERSION 5.00
  2. Begin VB.Form FAddressOMatic 
  3.    Caption         =   "Address-o-matic"
  4.    ClientHeight    =   3180
  5.    ClientLeft      =   3225
  6.    ClientTop       =   3450
  7.    ClientWidth     =   3015
  8.    Icon            =   "AddrOMatic.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   3180
  11.    ScaleWidth      =   3015
  12.    Begin VB.TextBox txtBlocks 
  13.       Height          =   324
  14.       Left            =   96
  15.       TabIndex        =   5
  16.       Text            =   "1"
  17.       Top             =   1104
  18.       Width           =   2775
  19.    End
  20.    Begin VB.TextBox txtBaseAddr 
  21.       Height          =   324
  22.       Left            =   96
  23.       Locked          =   -1  'True
  24.       TabIndex        =   4
  25.       Top             =   1884
  26.       Width           =   2775
  27.    End
  28.    Begin VB.TextBox txtReserved 
  29.       Height          =   324
  30.       Left            =   96
  31.       TabIndex        =   1
  32.       Text            =   "65536"
  33.       Top             =   360
  34.       Width           =   2775
  35.    End
  36.    Begin VB.CommandButton cmdNew 
  37.       Caption         =   "New Base Address"
  38.       Default         =   -1  'True
  39.       Height          =   495
  40.       Left            =   732
  41.       TabIndex        =   0
  42.       Top             =   2472
  43.       Width           =   1695
  44.    End
  45.    Begin VB.Label lbl 
  46.       Caption         =   "64 KB blocks:"
  47.       BeginProperty Font 
  48.          Name            =   "MS Sans Serif"
  49.          Size            =   8.25
  50.          Charset         =   0
  51.          Weight          =   700
  52.          Underline       =   0   'False
  53.          Italic          =   0   'False
  54.          Strikethrough   =   0   'False
  55.       EndProperty
  56.       Height          =   204
  57.       Index           =   2
  58.       Left            =   96
  59.       TabIndex        =   6
  60.       Top             =   852
  61.       Width           =   1452
  62.    End
  63.    Begin VB.Label lbl 
  64.       Caption         =   "Base address:"
  65.       BeginProperty Font 
  66.          Name            =   "MS Sans Serif"
  67.          Size            =   8.25
  68.          Charset         =   0
  69.          Weight          =   700
  70.          Underline       =   0   'False
  71.          Italic          =   0   'False
  72.          Strikethrough   =   0   'False
  73.       EndProperty
  74.       Height          =   204
  75.       Index           =   1
  76.       Left            =   96
  77.       TabIndex        =   3
  78.       Top             =   1632
  79.       Width           =   1812
  80.    End
  81.    Begin VB.Label lbl 
  82.       Caption         =   "Bytes to reserve:"
  83.       BeginProperty Font 
  84.          Name            =   "MS Sans Serif"
  85.          Size            =   8.25
  86.          Charset         =   0
  87.          Weight          =   700
  88.          Underline       =   0   'False
  89.          Italic          =   0   'False
  90.          Strikethrough   =   0   'False
  91.       EndProperty
  92.       Height          =   204
  93.       Index           =   0
  94.       Left            =   96
  95.       TabIndex        =   2
  96.       Top             =   108
  97.       Width           =   1452
  98.    End
  99. End
  100. Attribute VB_Name = "FAddressOMatic"
  101. Attribute VB_GlobalNameSpace = False
  102. Attribute VB_Creatable = False
  103. Attribute VB_PredeclaredId = True
  104. Attribute VB_Exposed = False
  105. Private Function DllBaseAddress(Optional ByVal Size As Long = 65535) As String
  106.     Dim iBase As Long, fDone As Boolean
  107.     
  108.     If Size < 65536 Then
  109.         Size = 1
  110.     Else
  111.         ' Reduce Size by factor of 64K and round up
  112.         Size = (Size \ 65536) - (Size Mod 65536 <> 0)
  113.     End If
  114.     
  115.     Do
  116.         ' Pick iBase from range available to component developers
  117.         iBase = Random(256, 32768 - Size)
  118.         ' Be sure iBase doesn't fall within unavailable ranges
  119.         
  120.         ' 0x00000000 - 0x0032FFFF  Crystal Reports
  121.         If (iBase >= &H0) And (iBase + Size <= &H32) Then
  122.             fDone = False
  123.         ' 0x0F9A0000 - 0x0FFFFFFF  VBA components
  124.         ElseIf (iBase >= &HF9A) And (iBase + Size <= &HFFF) Then
  125.             fDone = False
  126.         ' 0x0F000000 - 0x0F8BFFFF  Core VB components
  127.         ElseIf (iBase >= &HF00) And (iBase + Size <= &HF8B) Then
  128.             fDone = False
  129.         ' 0x20000000 - 0x24FFFFFF  VB controls
  130.         ElseIf (iBase >= &H2000) And (iBase + Size <= &H24FF) Then
  131.             fDone = False
  132.         ' 0x25000000 - 0x26FFFFFF  Crystal Reports
  133.         ElseIf (iBase >= &H2500) And (iBase + Size <= &H26FF) Then
  134.             fDone = False
  135.         ' 0x2E8B0000 - 0x2E9AFFFF  Hardcore components
  136.         ElseIf (iBase >= &H2E8B) And (iBase + Size <= &H2E9A) Then
  137.             fDone = False
  138.         ' 0x65000000 - 0x65FFFFFF  Office 97 components
  139.         ElseIf (iBase >= &H6500) And (iBase + Size <= &H65FF) Then
  140.             fDone = False
  141.         ' Insert your range here
  142.         'ElseIf (iBase >= &Hxxxx) And (iBase + Size <= &Hxxxx) Then
  143.         '    fDone = False
  144.         Else
  145.             fDone = True
  146.         End If
  147.     Loop While Not fDone
  148.     
  149.     DllBaseAddress = "&H" & Right$(String$(4, "0") & Hex$(iBase), 4) & "0000"
  150. End Function
  151.  
  152. Private Sub cmdNew_Click()
  153.     txtBaseAddr.SetFocus
  154.     txtBaseAddr = DllBaseAddress(txtReserved)
  155.     Clipboard.SetText txtBaseAddr
  156. End Sub
  157.  
  158. Private Sub txtBlocks_LostFocus()
  159.     Dim cBlocks As Long, cBytes As Long
  160.     cBlocks = Val(txtBlocks)
  161.     cBytes = cBlocks * 65536
  162.     txtReserved = CStr(cBytes)
  163. End Sub
  164.  
  165. Private Sub txtReserved_LostFocus()
  166.     Dim cBlocks As Long, cBytes As Long
  167.     cBytes = txtReserved
  168.     cBlocks = (cBytes \ 65536) - (cBytes Mod 65536 <> 0)
  169.     txtBlocks = cBlocks
  170. End Sub
  171.  
  172. Private Sub txtBlocks_GotFocus()
  173.     txtBlocks.SelStart = 0
  174.     txtBlocks.SelLength = 30
  175. End Sub
  176.  
  177. Private Sub txtReserved_GotFocus()
  178.     txtReserved.SelStart = 0
  179.     txtReserved.SelLength = 30
  180. End Sub
  181.  
  182.